HPAVC/HPAVC CD-ROM.iso/pc/ASMCODE.ZIP/TYPES.PAS

Pascal/Delphi Source File | 1994-11-02 | 11.1 KB | 426 lines

{ ────────────────────────────────────────────────────────────────────────

  This code is Copyright (c) 1994 by Jonathan E. Wright and AmoebaSoft.

  To communicate with the author, send internet mail to: [e-mail]

  About this code:
    This code was stripped from my normal global unit and error handler.
    I hope I didn't screw anything up.

    If you use this code in any of your programs, or as a basis for anything
    else you may write, please give credit to Nelno the Amoeba.  A postcard
    from your country or town would also be nice.  Send it to:

    Nelno
    58 1/2 Woodland Rd.
    Asheville, NC 28804-3823
    USA

  ────────────────────────────────────────────────────────────────────────
}

UNIT Types;

Interface

USES
  DOS;

CONST
  DebugKeys : BOOLEAN = TRUE;

  hexChars: array [0..$F] of Char = '0123456789ABCDEF';

  DOSErrorMess : ARRAY [2..17] OF STRING [44] =
    ('Could not locate the requested file.',
     'Path not found.',
     'Too many files open.',
     'File access denied. ',
     'Invalid file handle.', '', '', '', '', '',
     'Invalid file access code.', '', '',
     'Invalid drive number.',
     'Cannot remove current directory.',
     'Cannot rename accross drives.');

  CustErrorMess  : ARRAY [18..35] OF STRING [43] =
    ('Could not perform memory request.',
     'File has no palette.',
     'File being saved contains color #255.',
     'Entry not in library.',
     'No EMM manager present.',
     'Attempt to allocate EMMblock > 16384 bytes.',
     'EMM free list is full in ',
     'Too few pages to create requested EMM heap.',
     'EMM manager version is below 4.0.',
     'Attempt to read past end of file.',
     'Sample larger than 65020 bytes.',
     'No entries in library directory.',
     'Unrecognizable MOD format.',
     'Unknown format tag.',
     '',
     '',
     '',
     '');

  IOErrorMess  : ARRAY [100..106] OF STRING [24] =
    ('Disk read error', 'Disk write error', 'File not assigned',
     'File not open', 'File not open for input', 'File not open for output',
     'Invalid numeric format');

  CriticalErrorMess : ARRAY [150..162] OF STRING [20] =
    ('Disk is write-protected', 'Unknown unit',
     'Drive not ready', 'Unknown command', 'CRC error in data',
     'Disk seek error', 'Critical Error #155',
     'Unknown media type', 'Sector Not Found', 'Printer out of paper',
     'Device write fault', 'Device read fault', 'Hardware failure');

  FatalErrorMess : ARRAY [200..214] OF STRING [25] =
    ('Division by zero', 'Range check error', 'Stack overflow error',
     'Heap overflow error', 'Invalid pointer operation',
     'Floating point overflow', 'Floating point underflow',
     'Invalid F.L.O.P.', 'OVR manager not installed',
     'Overlay file read error', 'Object not initialized',
     'Call to abstract method', 'Fatal Error #212',
     'Fatal Error #213', 'Fatal Error #214');

VAR
  OldInt08        : POINTER;
  OldInt1C        : POINTER;

  ErrorMessage    : STRING [80];
  ErrorCode       : WORD;
  ErrorAddress    : POINTER;

FUNCTION  ST (n : LONGINT): STRING;
FUNCTION  Raise (n, x : INTEGER): LONGINT;
FUNCTION  Exists (FileName : STRING) : BOOLEAN;
PROCEDURE Print (S : STRING; Attribute : BYTE);
FUNCTION  HexWord (w : WORD): STRING;
FUNCTION  BinWord (n : WORD): STRING;
FUNCTION  HexByte (b : BYTE): STRING;
PROCEDURE ErrorHandler (UnitNum, n : WORD); FAR;

IMPLEMENTATION

VAR
  SavedExit : POINTER;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE NewExit; FAR;

BEGIN
  ExitProc := SavedExit;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION ST (n : LONGINT): STRING;

VAR
  S : STRING;

BEGIN
  STR (n, S);
  ST := S;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION Raise (n, x : INTEGER): LONGINT;

VAR
  Count : INTEGER;
  n1    : INTEGER;

BEGIN
  N1 := n;
  IF x = 0 THEN
    n := 0
  ELSE
    FOR Count := 1 to X - 1 DO
      N := n * n1;

  Raise := n;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION Exists (FileName : STRING) : BOOLEAN;

VAR
  InFile : FILE OF BYTE;

BEGIN
  ASSIGN (InFile, FileName);

  {$I-}
  RESET (InFile);
  {$I+}

  IF IOResult = 0 THEN
    Exists := TRUE
  ELSE
    Exists := FALSE;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE Print (S : STRING; Attribute : BYTE);

VAR
  R      : REGISTERS;
  X, CY  : BYTE;
  I      : INTEGER;
  T      : CHAR;

BEGIN
  R.AH := $03;   { get cursor position }
  R.BH := 0;

  Intr ($10, R);

  X := R.DL;
  CY := R.DH;

  FOR I := 1 to ORD (S [0]) DO
  BEGIN
    T := S [I];

    ASM
      mov    ah,9
      mov    al,T
      mov    bl,Attribute
      mov    bh,0
      mov    cx,1
      int    10h
    END;

    INC (X);

    IF X > 80 THEN
    BEGIN
      X := 0;
      INC (CY);
      IF CY > 24 THEN
      BEGIN
        ASM
          mov    ax,0601h
          mov    cx,0101h
          mov    dx,1950h
          mov    bh,07h
          int    10h

          mov    ah,2
          mov    dl,0
          mov    dh,24
          mov    bh,0
          int    10h

          mov    X,0
          mov    CY,24
        END;
      END;
    END;

    ASM
      mov    ah,2
      mov    dl,X
      mov    dh,CY
      mov    bh,0
      int    10h
    END;
  END;

  INC (CY);
  IF CY > 24 THEN
  BEGIN
    ASM
      mov    ax,0601h
      mov    cx,0101h
      mov    dx,1950h
      mov    bh,07h
      int    10h

      mov    ah,02
      mov    dl,0
      mov    dh,24
      mov    bh,0
      int    10h

      mov    X,0
      mov    CY,24
    END;
  END;
  ASM
    mov    ah,2
    mov    bh,0
    mov    dl,0
    mov    dh,CY

    int    10h
  END;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION HexWord (w : WORD): STRING;

VAR
  S : STRING;

BEGIN

 S := hexChars [Hi(w) shr 4] + hexChars [Hi(w) and $F] +
      hexChars [Lo(w) shr 4] + hexChars [Lo(w) and $F];

 HexWord := S;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║ FUNCTION BinWord (n : WORD): STRING;                                  ║
  ║                                                                       ║
  ╟───────────────────────────────────────────────────────────────────────╢
  ║                                                                       ║
  ║ returns a string containing the binary equivalent of the value of n   ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION BinWord (n : WORD): STRING;

VAR
  I, Temp : WORD;
  S       : STRING;

BEGIN
  S := '                ';

  I := 16;

  WHILE (I > 0) DO
  BEGIN
    Temp := n MOD 2;
    n := n DIV 2;
    S [I] := CHR (Temp + 48);
    DEC (I);
  END;

  INSERT ('∙', S, 9);

  BinWord := S;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION HexByte (b : BYTE): STRING;

VAR
  S : STRING;

BEGIN
 S := hexChars [b shr 4] + hexChars [b and $F];

 HexByte := S;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE ClrScr; ASSEMBLER;

ASM
  mov     ah,02
  xor     dx,dx
  xor     bx,bx

  int     10h    { set cursor position }

  mov     ah,09
  mov     al,20h
  xor     bx,bx
  mov     bl,07
  mov     cx,2000

  int     10h
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║ Error handler for all units.                                          ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE ErrorHandler (UnitNum, n : WORD);

BEGIN
  ASM
    mov     ax,[bp]                     { get return address from stack }
    mov     dx,[bp+02]

    mov     word ptr ErrorAddress [0],ax
    mov     word ptr ErrorAddress [2],dx
  END;

  CASE n OF
      2..17 : ErrorMessage := DOSErrorMess [n];
      18..35: ErrorMessage := CustErrorMess [n];
    100..106:
          ErrorMessage := IOErrorMess [n];
    150..162:
          ErrorMessage := CriticalErrorMess [n];
    200..214:
          ErrorMessage := FatalErrorMess [n];
    ELSE ErrorMessage := 'Unknown';
  END;

  ErrorCode := n;

  Halt (UnitNum);
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

VAR
  I : INTEGER;

BEGIN
  ErrorAddress := NIL;
  ErrorCode := 0;
  ErrorMessage := '';

  GetIntVec ($1C, OldInt1C);
  GetIntVec ($08, OldInt08);

  SavedExit := ExitProc;
  ExitProc := @NewExit;

  ClrScr;
END.